home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / cal-hebrew.el < prev    next >
Lisp/Scheme  |  1996-01-20  |  57KB  |  1,181 lines
  1. ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
  2.  
  3. ;; Copyright (C) 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
  6. ;;      Edward M. Reingold <reingold@cs.uiuc.edu>
  7. ;; Keywords: calendar
  8. ;; Human-Keywords: Hebrew calendar, calendar, diary
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; This collection of functions implements the features of calendar.el and
  30. ;; diary.el that deal with the Hebrew calendar.
  31.  
  32. ;; Comments, corrections, and improvements should be sent to
  33. ;;  Edward M. Reingold               Department of Computer Science
  34. ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  35. ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  36. ;;                                   Urbana, Illinois 61801
  37.  
  38. ;;; Code:
  39.  
  40. (require 'calendar)
  41.  
  42. (defun calendar-hebrew-from-absolute (date)
  43.   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
  44. The absolute date is the number of days elapsed since the (imaginary)
  45. Gregorian date Sunday, December 31, 1 BC."
  46.   (let* ((greg-date (calendar-gregorian-from-absolute date))
  47.          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
  48.                  (1- (extract-calendar-month greg-date))))
  49.          (day)
  50.          (year (+ 3760 (extract-calendar-year greg-date))))
  51.     (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
  52.         (setq year (1+ year)))
  53.     (let ((length (hebrew-calendar-last-month-of-year year)))
  54.       (while (> date
  55.                 (calendar-absolute-from-hebrew
  56.                  (list month
  57.                        (hebrew-calendar-last-day-of-month month year)
  58.                        year)))
  59.         (setq month (1+ (% month length)))))
  60.     (setq day (1+
  61.                (- date (calendar-absolute-from-hebrew (list month 1 year)))))
  62.     (list month day year)))
  63.  
  64. (defun hebrew-calendar-leap-year-p (year)
  65.   "t if YEAR is a Hebrew calendar leap year."
  66.   (< (% (1+ (* 7 year)) 19) 7))
  67.  
  68. (defun hebrew-calendar-last-month-of-year (year)
  69.   "The last month of the Hebrew calendar YEAR."
  70.   (if (hebrew-calendar-leap-year-p year)
  71.       13
  72.     12))
  73.  
  74. (defun hebrew-calendar-last-day-of-month (month year)
  75.   "The last day of MONTH in YEAR."
  76.   (if (or (memq month (list 2 4 6 10 13))
  77.           (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
  78.           (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
  79.           (and (= month 9) (hebrew-calendar-short-kislev-p year)))
  80.       29
  81.     30))
  82.  
  83. (defun hebrew-calendar-elapsed-days (year)
  84.   "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
  85.   (let* ((months-elapsed
  86.           (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
  87.              (* 12 (% (1- year) 19))      ;; Regular months in this cycle
  88.              (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
  89.          (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
  90.          (hours-elapsed (+ 5
  91.                            (* 12 months-elapsed)
  92.                            (* 793 (/ months-elapsed 1080))
  93.                            (/ parts-elapsed 1080)))
  94.          (parts                                  ;; Conjunction parts
  95.           (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
  96.          (day                                    ;; Conjunction day
  97.           (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
  98.          (alternative-day
  99.           (if (or (>= parts 19440)    ;; If the new moon is at or after midday,
  100.                   (and (= (% day 7) 2);; ...or is on a Tuesday...
  101.                        (>= parts 9924)  ;;    at 9 hours, 204 parts or later...
  102.                        (not (hebrew-calendar-leap-year-p year)));; of a
  103.                                                                 ;; common year,
  104.                   (and (= (% day 7) 1);; ...or is on a Monday...
  105.                        (>= parts 16789) ;;   at 15 hours, 589 parts or later...
  106.                        (hebrew-calendar-leap-year-p (1- year))));; at the end
  107.                                                      ;; of a leap year
  108.        ;; Then postpone Rosh HaShanah one day
  109.               (1+ day)
  110.        ;; Else
  111.             day)))
  112.     (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
  113.         (memq (% alternative-day 7) (list 0 3 5))
  114.   ;; Then postpone it one (more) day and return        
  115.         (1+ alternative-day)
  116.   ;; Else return        
  117.       alternative-day)))
  118.  
  119. (defun hebrew-calendar-days-in-year (year)
  120.   "Number of days in Hebrew YEAR."
  121.   (- (hebrew-calendar-elapsed-days (1+ year))
  122.      (hebrew-calendar-elapsed-days year)))
  123.  
  124. (defun hebrew-calendar-long-heshvan-p (year)
  125.   "t if Heshvan is long in Hebrew YEAR."
  126.   (= (% (hebrew-calendar-days-in-year year) 10) 5))
  127.  
  128. (defun hebrew-calendar-short-kislev-p (year)
  129.   "t if Kislev is short in Hebrew YEAR."
  130.   (= (% (hebrew-calendar-days-in-year year) 10) 3))
  131.  
  132. (defun calendar-absolute-from-hebrew (date)
  133.   "Absolute date of Hebrew DATE.
  134. The absolute date is the number of days elapsed since the (imaginary)
  135. Gregorian date Sunday, December 31, 1 BC."
  136.   (let* ((month (extract-calendar-month date))
  137.          (day (extract-calendar-day date))
  138.          (year (extract-calendar-year date)))
  139.     (+ day                            ;; Days so far this month.
  140.        (if (< month 7);; before Tishri
  141.      ;; Then add days in prior months this year before and after Nisan
  142.            (+ (calendar-sum
  143.                m 7 (<= m (hebrew-calendar-last-month-of-year year))
  144.                (hebrew-calendar-last-day-of-month m year))
  145.               (calendar-sum
  146.                m 1 (< m month)
  147.                (hebrew-calendar-last-day-of-month m year)))
  148.      ;; Else add days in prior months this year
  149.          (calendar-sum
  150.           m 7 (< m month)
  151.           (hebrew-calendar-last-day-of-month m year)))
  152.     (hebrew-calendar-elapsed-days year);; Days in prior years.
  153.     -1373429)))                        ;; Days elapsed before absolute date 1.
  154.  
  155. (defvar calendar-hebrew-month-name-array-common-year
  156.   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
  157.    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
  158.  
  159. (defvar calendar-hebrew-month-name-array-leap-year
  160.   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
  161.    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
  162.  
  163. (defun calendar-hebrew-date-string (&optional date)
  164.   "String of Hebrew date before sunset of Gregorian DATE.
  165. Defaults to today's date if DATE is not given.
  166. Driven by the variable `calendar-date-display-form'."
  167.   (let* ((hebrew-date (calendar-hebrew-from-absolute
  168.                        (calendar-absolute-from-gregorian
  169.                         (or date (calendar-current-date)))))
  170.          (calendar-month-name-array
  171.           (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
  172.               calendar-hebrew-month-name-array-leap-year
  173.             calendar-hebrew-month-name-array-common-year)))
  174.     (calendar-date-string hebrew-date nil t)))
  175.  
  176. (defun calendar-print-hebrew-date ()
  177.   "Show the Hebrew calendar equivalent of the date under the cursor."
  178.   (interactive)
  179.   (message "Hebrew date (until sunset): %s"
  180.            (calendar-hebrew-date-string (calendar-cursor-to-date t))))
  181.  
  182. (defun hebrew-calendar-yahrzeit (death-date year)
  183.   "Absolute date of the anniversary of H